home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / graphics / bgires.zip / BGIRES.PAS < prev    next >
Pascal/Delphi Source File  |  1992-07-11  |  9KB  |  306 lines

  1. unit bgires;
  2.  
  3. { Unit to handle .BGI files in a resource file. }
  4.  
  5. interface
  6.  
  7. uses
  8.   objects,graph                       { standard units }
  9.  
  10. {$ifndef NOSTREAMS} ,streams {$endif}; { my streams unit }
  11.  
  12. procedure ResInitGraph(var graphdriver,graphmode:integer;
  13.                        var resfile:TResourcefile;
  14.                        pathtodriver:string);
  15. { Attempts to load the given driver (which may be Detect) from the
  16.   resource file, register it, and call initgraph.  PathToDriver will
  17.   only be used if the driver isn't in the resource file. }
  18.  
  19. function PutDriver(filename:string;var resfile:TResourcefile;
  20.                    keep:boolean):integer;
  21. { Puts driver 'filename' into the given resource file.  If keep is true,
  22.   leaves it loaded in memory.  If keep is false, deletes it from memory, but
  23.   leaves Graph unstable.  Returns a graphics error constant.}
  24.  
  25. function PutAllDrivers(path:string;var resfile:TResourcefile;
  26.                        keep:boolean):integer;
  27. { Puts all the standard drivers into the given resource file; assumes
  28.   that it can find them all in the given path (terminated with a backslash,
  29.   e.g. "c:\drivers\".  Returns all graphics error constants from PutDriver
  30.   or'd together.}
  31.  
  32. procedure DelDriver(Graphdriver:integer;var resfile:TResourcefile);
  33. { Deletes the driver with the given number from the resource file.  Numbers
  34.   are those used by InitGraph, i.e. CGA=1, VGA=9, etc.
  35.   NB:  Some drivers handle several devices, so for example deleting VGA will also
  36.        take out EGA.  The standard list is:
  37.  
  38.          File          Graphdriver constants
  39.  
  40.          CGA.BGI:      CGA, MCGA
  41.          EGAVGA.BGI:   EGA, EGA64, EGAMono, VGA
  42.          IBM8514.BGI:  IBM8514
  43.          HERC.BGI:     HercMono
  44.          ATT.BGI:      ATT400
  45.          PC3270.BGI:   PC3270 }
  46.  
  47. type
  48.   PResourcefile2 = ^TResourcefile2;
  49.   TResourcefile2 = object(TResourcefile)
  50.     { A resource file that knows how to pack itself. }
  51.  
  52.     procedure Pack;
  53.     { Packs in place.  This works even if the resource file
  54.     is embedded in a larger file, e.g. an .EXE file with overlays and
  55.     resources.  Note that whatever follows the resource file will be moved;
  56.     something like the overlay manager would need to be reinitialized
  57.     afterwards.
  58.  
  59.     This really belongs in the Streams or Objects unit; it will be
  60.     moved there in future versions. }
  61.   end;
  62.  
  63.   PBGIDriver = ^TBGIDriver;
  64.   Tbgidriver = object(TObject)
  65.     location : pointer;  { Where the .bgi file is loaded }
  66.     size : word;         { The size of the file }
  67.     number : integer;    { Internal driver number }
  68.  
  69.     constructor init(filename : string);
  70.     destructor done; virtual;
  71.     { Dispose of memory used by driver.
  72.       NB:  leaves Graph unit unstable :-( }
  73.  
  74.     constructor load(var S:TStream);
  75.     procedure store(var S:TStream);
  76.   end;
  77.  
  78.   { These constants are in separate blocks so that you don't link any of
  79.     them unless you need them. }
  80.  
  81. const
  82.   drivernum : array[1..10] of word = (0,0,1,1,1,2,3,4,1,5);
  83.   { These are the internal driver numbers for graphdriver values 1 to 10. }
  84. const
  85.   drivernames : array[0..5] of String[11] =
  86.    ('CGA.BGI', 'EGAVGA.BGI', 'IBM8514.BGI',
  87.     'HERC.BGI', 'ATT.BGI', 'PC3270.BGI');
  88. const
  89.   { Stream registration number and record for TBGIDriver }
  90.   BGITypeCode = $4247;   { 'BG' }
  91.   RBGIDriver : TStreamRec = (
  92.           ObjType: BGItypecode;
  93.           VmtLink: Ofs(TypeOf(TBGIDriver)^);
  94.           Load:    @TBGIDriver.Load;
  95.           Store:   @TBGIDriver.Store
  96.           );
  97.  
  98. implementation
  99.  
  100. constructor TBGIDriver.init(filename:string);
  101. var
  102.   src : TDosstream;
  103.   success : boolean;
  104. begin
  105.   success := false;
  106.   src.init(filename,stOpenRead);
  107.   if src.status = stOk then
  108.   begin
  109.     size   := src.getsize;           { Assumes size <= 64K }
  110.     if maxavail >= size then
  111.     begin
  112.       getmem(location,size);
  113.       src.read(location^,size);
  114.       if src.status = stOk then
  115.       begin
  116.         number := RegisterBGIDriver(location);
  117.         if number >= 0 then
  118.           success := true;
  119.       end;
  120.       if not success then
  121.         freemem(location,size);
  122.     end;
  123.   end;
  124.   src.done;
  125.   if not success then
  126.     fail;
  127. end;
  128.  
  129. destructor TBGIDriver.done;
  130. begin
  131.   freemem(location,size);   { Dangerous!  Graph still thinks the driver
  132.                               is there. }
  133.   TObject.done;
  134. end;
  135.  
  136. constructor TBGIDriver.load(var S:TStream);
  137. begin
  138.   S.read(size,sizeof(size));
  139.   if memavail >= size then
  140.   begin
  141.     getmem(location, size);
  142.     S.read(location^, size);
  143.     if S.status = stOK then
  144.     begin
  145.       number := RegisterBGIDriver(location);
  146.       if number >= 0 then
  147.         exit;  { Success! }
  148.     end;
  149.     freemem(location, size);
  150.   end;
  151.   fail;
  152. end;
  153.  
  154. procedure TBGIDriver.store(var S:TStream);
  155. begin
  156.   S.write(size,sizeof(size));
  157.   S.write(location^,size);
  158. end;
  159.  
  160. procedure ResInitGraph(var graphdriver,graphmode:integer;
  161.                      var resfile:TResourcefile;
  162.                      pathtodriver:string);
  163. var
  164.   name : string;
  165.   bgi : PBGIDriver;
  166. begin
  167.   if graphdriver = Detect then
  168.     DetectGraph(graphdriver,graphmode);
  169.   if (1 <= graphdriver) and (graphdriver <= 10) then
  170.   begin
  171.     str(drivernum[graphdriver],name);
  172.     name := 'bgi'+name;
  173.     bgi := PBGIDriver(resfile.Get(name));
  174.   end;
  175.   initgraph(graphdriver,graphmode,pathtodriver);
  176. end;
  177.  
  178. function PutDriver(filename:string;var resfile:TResourcefile;keep:boolean):integer;
  179. { Puts driver 'filename' into the given resource file.  Leaves it loaded
  180.   in memory if keep is true; otherwise, deletes it (but leaves Graph unit
  181.   unstable). }
  182. var
  183.   BGI : TBGIDriver;
  184.   num : string;
  185. begin
  186.   if BGI.init(filename) then
  187.   begin
  188.     str(BGI.number,num);
  189.     resfile.Put(@BGI,'bgi'+num);
  190.     if resfile.stream^.status = stOk then
  191.       PutDriver := grOK
  192.     else
  193.       PutDriver := grError;
  194.     if not keep then
  195.       BGI.done;
  196.   end
  197.   else
  198.     PutDriver := grFileNotfound;
  199. end;
  200.  
  201. function PutAllDrivers(path:string;var resfile:TResourceFile;keep:boolean):integer;
  202. { Puts all the standard drivers into the given resource file; assumes
  203.   that it can find them all in the given path (terminated with a backslash,
  204.   e.g. "c:\drivers\" }
  205. var
  206.   result : integer;
  207. begin
  208.   PutAllDrivers :=    PutDriver(path+'ATT.BGI',resfile,keep)
  209.                    or PutDriver(path+'CGA.BGI',resfile,keep)
  210.                    or PutDriver(path+'EGAVGA.BGI',resfile,keep)
  211.                    or PutDriver(path+'HERC.BGI',resfile,keep)
  212.                    or PutDriver(path+'IBM8514.BGI',resfile,keep)
  213.                    or PutDriver(path+'PC3270.BGI',resfile,keep);
  214. end;
  215.  
  216. procedure DelDriver(graphdriver:integer;var resfile:TResourcefile);
  217. { Deletes the driver with the given number from the resource file.  Numbers
  218.   are those used by InitGraph. }
  219. var
  220.   num : string;
  221. begin
  222.   if (1 <= graphdriver) and (graphdriver <= 10) then
  223.   begin
  224.     str(drivernum[graphdriver],num);
  225.     resfile.delete('bgi'+num);
  226.   end;
  227. end;
  228.  
  229.  
  230. procedure TResourcefile2.Pack;
  231.  
  232. type
  233.   {$ifndef ver60}
  234.   This declaration may be TP 6.0 specific!!
  235.   {$endif}
  236.  
  237.   resrec = record    { These are the fields of Objects.TResourceFile,
  238.                        including the private ones. }
  239.     vmtptr : word;
  240.     stream : PStream;
  241.     modified : boolean;
  242.     basepos : longint;
  243.     indexpos: longint;
  244.     index : TResourceCollection;
  245.   end;
  246.  
  247.   TResFileHeader = record
  248.     Signature: array[1..4] of char;
  249.     ResFileSize: Longint;
  250.     IndexOffset: Longint;
  251.   end;
  252.  
  253. var
  254.   temp : PStream;
  255.   oldstream : PStream;
  256.   header : TResFileHeader;
  257.   size,basepos : longint;
  258.   i : integer;
  259.   selfrec : resrec absolute self;
  260. begin
  261.   flush;
  262.   basepos := selfrec.basepos;
  263.   stream^.seek(basepos);
  264.   stream^.read(header,sizeof(header));
  265.   if header.signature <> 'FBPR' then
  266.     exit;  { Don't do any packing, just quit }
  267.  
  268.   size := stream^.GetSize - basepos;     { get the size for temp }
  269.  
  270. {$ifndef NOSTREAMS}
  271.   temp := Tempstream(12,size, forspeed);
  272. {$else}
  273.   { If you don't have Streams, you can make the following poor substitution
  274.     by defining NOSTREAMS: }
  275.   temp := New(PDOSStream,init('bgires.tmp',stCreate));
  276.   { but if you do, you'll have to manually erase bgires.tmp when the demo is
  277.     done. }
  278. {$endif}
  279.   if temp = nil then
  280.     exit;  { Again, can't proceed, so quit. }
  281.   oldstream := switchto(temp, true);     { pack res to temp }
  282.   flush;
  283.  
  284.   oldstream^.seek(basepos + 8 + header.resfilesize);    { copy the rest of oldstream }
  285.   temp^.seek(temp^.getsize);
  286.   temp^.copyfrom(oldstream^, oldstream^.getsize - oldstream^.getpos);
  287.  
  288.   oldstream^.seek(basepos);                  { copy it all back to the old
  289.                                                stream }
  290.   temp^.seek(0);
  291.   oldstream^.copyfrom(temp^, temp^.getsize);
  292.   oldstream^.truncate;
  293.  
  294.   { Reinstall the old stream into res, and get rid of temp }
  295.   stream := oldstream;
  296.   selfrec.basepos  := basepos;
  297.  
  298.   dispose(temp,done);
  299. end;
  300.  
  301. { Startup code registers the TBGIDriver type. }
  302.  
  303. begin
  304.   Registertype(RBGIDriver);
  305. end.
  306.